home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / bounce.exe / BOUNCE.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-08-17  |  4.1 KB  |  156 lines
  1. {$N-} {Much Better with $N+}
  2. Program Bounce;
  3.  
  4. Uses WinProcs, WinTypes, WObjects;
  5.  
  6. Type
  7.     PBounceWnd = ^TBounceWnd;
  8.     TBounceWnd = Object(TWindow)
  9.        hBallBitMap  : hBitMap;
  10.        hdcMem       : hDC;
  11.        hMyBrush     : hBrush;
  12.        TheDC        : hDC;
  13.        cxClient,
  14.        cyClient        : Word;
  15.        xPixel,
  16.        yPixel        : Integer;
  17.        xCenter,
  18.        yCenter        : Integer;
  19.        cxTotal,
  20.        cyTotal        : Integer;
  21.        cxRadius,
  22.        cyRadius        : Integer;
  23.        cxMove,
  24.        cyMove        : Integer;
  25.  
  26.        nScale        : Integer;
  27.  
  28.         Constructor Init(AParent : PWindowsObject; ATitle : PChar);
  29.         Procedure WMCreate(Var Msg : TMessage);
  30.           Virtual wm_First + wm_Create;
  31.         Procedure WMDestroy(Var Msg : TMessage);
  32.           Virtual wm_First + wm_Destroy;
  33.         Procedure WMSize(Var Msg : TMessage);
  34.           Virtual wm_First + wm_Size;
  35.         Procedure WMTimer(Var Msg : TMessage);
  36.           Virtual wm_First + wm_Timer;
  37.     End;
  38.  
  39.     TBounceApp = Object(TApplication)
  40.         Procedure InitMainWindow; Virtual;
  41.     End;
  42.  
  43. Constructor TBounceWnd.Init(AParent :PWindowsObject; ATitle : PChar);
  44.  
  45. Begin
  46.     TWindow.Init(AParent, ATitle);
  47. End;
  48.  
  49. Procedure TBounceWnd.WMCreate(Var Msg : TMessage);
  50. Begin
  51.     TWindow.WMCreate(Msg);
  52.     If Not Boolean(SetTimer(hWindow, 1, 75, nil)) Then
  53.     Begin
  54.         MessageBox(hWindow, 'Couldn''t Init Timer', 'Bounce',
  55.                 MB_IconExclamation or mb_Ok);
  56.         Done;
  57.     End;
  58.     TheDC := GetDC(hWindow);
  59.     If TheDC = 0 Then
  60.     Begin
  61.         MessageBox(hWindow, 'We didn''t get the DC', 'Create', mb_Ok);
  62.         Done;
  63.     End;
  64.     xPixel := GetDeviceCaps(TheDC, AspectX);
  65.     yPixel := GetDeviceCaps(TheDC, AspectY);
  66.     ReleaseDC(hWindow, TheDC);
  67. End;
  68.  
  69. Procedure TBounceWnd.WMDestroy(Var Msg : TMessage);
  70. Begin
  71.     if hBallBitMap <> 0 Then DeleteObject(hBallBitMap);
  72.     KillTimer(hWindow, 1);
  73.     TWindow.WMDestroy(Msg);
  74. End;
  75.  
  76. Procedure TBounceWnd.WMSize(Var Msg : TMessage);
  77.  
  78. Begin
  79.     cxClient := LoWord(Msg.lParam);
  80.     cyClient := HiWord(Msg.lParam);
  81.     xCenter  := cxClient div 2;
  82.     yCenter     := cyClient div 2;
  83.     If (cxClient * xPixel) < (cyClient * yPixel) Then
  84.       nScale := (cxClient * xPixel) div 16
  85.      Else nScale := (cyClient * yPixel) div 16;
  86.     cxRadius := nScale div xPixel;
  87.     cyRadius := nScale div yPixel;
  88.     If (cxRadius div 4) > 1 Then cxMove := cxRadius div 4
  89.      Else cxMove := 1;
  90.     If (cyRadius div 4) > 1 Then cyMove := cyRadius div 4
  91.      Else cyMove := 1;
  92.     cxTotal := 2 * (cxRadius + cxMove);
  93.     cyTotal := 2 * (cyRadius + cyMove);
  94.  
  95.     If hBallBitMap <> 0 Then DeleteObject(hBallBitMap);
  96.  
  97.     TheDC := GetDC(hWindow);
  98.     hDCMem := CreateCompatibleDC(TheDC);
  99.     hBallBitMap := CreateCompatibleBitMap(TheDC, cxTotal, cyTotal);
  100.     ReleaseDC(hWindow, TheDC);
  101.  
  102.     SelectObject(hdcMem, hBallBitMap);
  103.     Rectangle(hdcMem, -1, -1, cxTotal + 1, cyTotal +1);
  104.  
  105.     hMyBrush := CreateHatchBrush(HS_DiagCross, LongInt(0));
  106.     SelectObject(hdcMem, hMyBrush);
  107.     SetBkColor(hdcMem, RGB(255,0,255));
  108.  
  109.     Ellipse(hdcMem, cxMove, cyMove, cxTotal - cxMove, cyTotal - cyMove);
  110.  
  111.     DeleteDC(hdcMem);
  112.     DeleteObject(hMyBrush);
  113.  
  114. {    TWindow.WMSize(Msg);
  115. }
  116. End;
  117.  
  118. Procedure TBounceWnd.WMTimer(Var Msg : TMessage);
  119.  
  120. Begin
  121.   If hBallBitMap <> 0 Then
  122.   Begin
  123. {
  124.     MessageBeep(10);
  125. }
  126.     TheDC := GetDC(hWindow);
  127.     hdcMem := CreateCompatibleDC(TheDC);
  128.     SelectObject(hdcMem, hBallBitMap);
  129.     BitBlt(TheDC, xCenter - cxTotal div 2, yCenter - cyTotal div 2,
  130.             cxTotal, cyTotal, hdcMem, 0, 0, SrcCopy);
  131.  
  132.     ReleaseDC(hWindow, TheDC);
  133.     DeleteDC(hdcMem);
  134.  
  135.     Inc(xCenter, cxMove);
  136.     Inc(yCenter, cyMove);
  137.     If ((xCenter + cxRadius >= cxClient) or (xCenter - cxRadius <=0)) Then
  138.       cxMove := cxMove * (-1);
  139.     If ((yCenter + cyRadius >= cyClient) or (yCenter - cyRadius <=0)) Then
  140.       cyMove := cyMove * (-1);
  141.  
  142.   End;
  143. End;
  144.  
  145. Procedure TBounceApp.InitMainWindow;
  146. Begin
  147.     MainWindow := New(PBounceWnd, Init(Nil, 'Draw A Bounce'));
  148. End;
  149.  
  150. Var BounceApp : TBounceApp;
  151.  
  152. Begin
  153.     BounceApp.Init('Bounce');
  154.     BounceApp.Run;
  155.     BounceApp.Done;
  156. End.